00010	;; FORTRAN CALLABLE SOUND OUTPUT SUBROUTINE.-- CALL PLAY(NAME,CHNS,SPD)
00100		TITLE	PLAY;
00200		INTERNAL PLAY
00300	
00400	;  CALL PLAY(FILENAME,SPEED,NCHNS)
00500	
00600	A   ←   1     ;WORK
00700	B   ←   2     ;WORK
00800	RET ←   3     ;RETURN ACCUMULATOR
00900	BUFSIZ ←=4096   
01000	↓DSKCHN ←17            ;DISK CHANNEL FOR INPUT
01100	↓ADCHN  ←12             ;D-A CHANNEL FOR OUTPUT
01200	NWD:	0			;FOR NUMBER OF WORDS OF INPUT.
01300	↓BUF1:	BLOCK	BUFSIZ+1	;BUFFER 1
01400	BUF2:	BLOCK	BUFSIZ+1	;BUFFER 2
01500	
01600	FILBLK: 0        		;FILENAME FOR INPUT
01700		'DMD   '			;EXTENSION
01800		0			;INFORMATION ON FILE
01900		0			;PROJECT PROG#
02000	
02100	
02200	CLIST:	IOWD	1,NWD		;FOR THE FIRST RECORD
02300		0
02400	
02500	INLIST:	0			;WILL CONTAIN AN IOWD
02600		0
02700	
02800	OUTWC:	0			;WILL CONTAIN AN IOWD FOR D-A
02900		3650			;MAGIC BITS FOR 136.
03000	OUTBIT: 4000			;BITS FOR D-A
03100		BLOCK	2
03200	
03300		OPDEF	READCH [51B8]
03400	        OPDEF   MESSAGE[51B8!3B12]
03500	
03600	PLAY:	0
03700	;;	CALLI	0,0         ;RESET I/O DEVICES
03800	 	OPEN 	DSKCHN,[17  ;MODE
03900			'DSK   '    ;DEVICE NAME
04000	 		0]          ;NO BUFFER HEADERS
04100		HALT	PLAY        ;RESTART IF DEVICE IS UNAVAILABLE
04200	
04300		SETZM	FILBLK+3    ;FOR RESTART
04400	;;LX:	MESSAGE [ASCIZ/
04500	;;  TYPE `P' TO PLAY FROM DISK
04600	;;/]
04700	;;	readch a
04800	;;	caie a,"P"
04900	;;	jrst lx
05000	;;	skipe filblk+3	;is this first time through ?
05100	;;	jrst pla2	;No. Parameters already set up.
05200		;FIND OUT NUMBER OF CHANNELS AND
05300		;THE SPEED.
05400	
05500	;	MESSAGE	[ASCIZ/HOW MANY CHANNELS? /]
05600	;	READCH	A
05700	;	SUBI	A,"0"+1		;CONVERT TO BINR AND ADD 1
05800		MOVE	A,@1(16)
05900		SUBI 	A,1
06000		DPB	A,[POINT 2,OUTBIT,26]
06100	
06200	;	MESSAGE [ASCIZ/ WHAT IS THE SPEED? /]
06300	;	READCH  A
06400	;	SUBI	A,"0"
06500		MOVE	A,@2(16)
06600		DPB	A,[POINT 3,OUTBIT,32]
06700	
06800	;	LX:	MESSAGE [ASCIZ/
06900	;	  TYPE `P' TO PLAY FROM DISK OR `E' TO EXIT
07000	;	/]
07100	;	readch a
07200	;	cain a,"E"
07300	;	JRA 16,3(16)
07400	;	caie a,"P"
07500	;	jrst lx
07600	
     

00100	PLA2:	SETZM FILBLK+3
00200		MOVE 	A,(16)		;ADR OF FILENAME
00300		SUBI 	A,1
00400		HRLI	A,000700	;BYTE POINTER
00500		MOVEI	B,FILBLK	;ADDRESS FOR SIXBIT
00600		SUBI	B,1
00700		HRLI	B,000600
00800		MOVEI	0,0
00900		SUBI	0,5
01000		
01100	SIXCNV:	ILDB	4,A
01200		ADDI	4,40
01300		IDPB	4,B
01400		AOJL	0,SIXCNV
01500	
01600	
01700		LOOKUP	DSKCHN,FILBLK
01800		JRST	[MESSAGE[ASCIZ/
01900			*** MUSIC FILE NOT FOUND/]
02000			JRA 16,3(16)]
02100	        ;EXIT IF FILE IS MISSING
02200	
02300	XOPEN:	MOVSI	'XGP'	;DOWN TO XGPOK FOR XGP CONFLICT.
02400		DEVUSE	0,	
02500		HLRZ 	0,0
02600		CAIN	400000
02700		JRST	XGPOK
02800		INIT	16,17
02900		SIXBIT	.XGP.
03000		0
03100		JRA	16,3(16)
03200	XGPOK:	OPEN	ADCHN,[117 	;MODE
03300	         	'AD    '        ;DEVICE NAME
03400	 		0]              ;NO BUFFER HEADERS
03500	
03600	  	JRST	[MESSAGE[ASCIZ/
03700			***D-A NOT AVAILABLE/]
03800			JRA 16,3(16)]
03900		;EXIT IF D-A IS UNAVAILABLE
04000	
04100	SPWAR:	SPCWAR 17,[CALLI]
04200	;	MESSAGE [ASCIZ/ GO? /]
04300	;	READCH A
04400	
04500	
04600	LNTH:	movs a,filblk+3		;get length of file.
04700		movnm a,nwd
04800	
04900	;	-----------------------------------------
05000	
05100		;BEGIN MAIN BODY OF PROGRAM
05200	
05300	LOOP:	JSP	RET,SUB		;ROUTINE TO READ AND WRITE
05400		BUF1-1 			;USE BUF1 FOR THE I/O
05500		JUMPLE	B,OUT    	;DONE
05600		
05700		JSP	RET,SUB		;CALL IT AGAIN
05800		BUF2-1			;USE BUF2 FOR THE I/O
05900		JUMPG	B,LOOP		;GO BACK FOR MORE IF B>0
06000	
06100	OUT:	close dskchn,		;END OF PROGRAM.
06200		releas adchn,
06300		RELEASE 16,
06400		SPCWAR 0,'SSW'
06500		JRA 16,3(16)
06600	;	jrst lx
06700	
06800		;SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
06900		;  1(RET) WILL BE THE RETURN
07000		;  0(RET) WILL BE THE ADDRESS OF THE BUFFER TO BE
07100		;         PUT IN THE RIGHT HALF OF THE IOWD.
07200		;  A      WILL BE A WORK REGISTER
07300	    	;  B      WILL BE TESTED ON THE OUTSIDE.
07400	
07500	SUB:	MOVNI	A,BUFSIZ	;PICK UP AND COMPLEMENT BUFSIZ
07600		ADDB	A,NWD		;A←NWD-BUFSIZ
07700					;NWD←NWD-BUFSIZ
07800		MOVE	B,A		;SAVE B TO BE TESTED FOR LAST
07900					;TIME.
08000		JUMPL	A,LAST		;SET UP FOR LAST TIME.
08100		MOVEI	A,0		
08200	
08300		;THE IOWD LOOKS LIKE:
08400		;  [-BUFSIZ / BUFI-1]
08500	
08600	LAST:	ADDI	A,BUFSIZ
08700		MOVNS	A		;COMPLEMENT A
08800		HRL	A,0(RET)	;PICK UP BUFI AND MOVE IT
08900					;TO THE LEFT SIDE OF A.
09000		MOVSM	A,INLIST	;SWAP A AND MOVE IT.
09100		MOVSM	A,OUTWC		;SAME FOR OUTPUT.
09200		INPUT	DSKCHN,INLIST	;READ A RECORD.
09300		OUTPUT	ADCHN,OUTWC	;WRITE THE RECORD.
09400		JRST	1(RET)		;RETURN
09500	
09600	END